***                                                                                                                                                                                                                                                       
***                                                                                                                                                                                                                                                       
*** This Program already converted to Y2K                                                                                                                                                                                                                 
*** S&T Departement     on 29 April 1999 by Ben.Rahman                                                                                                                                                                                                    
***                                                                                                                                                                                                                                                       
***                                                                                                                                                                                                                                                       
set cent on                                                                                                                                                                                                                                               
***                                                                                                                                                                                                                                                       
*** Program Name : REPMDRUG                                                                                                                                                                                                                               
*** Purpose      : to print monthly report of quantitative analysis of                                                                                                                                                                                    
***                sales of drugs.                                                                                                                                                                                                                        
***                Incl. calculation (calculate first                                                                                                                                                                                                     
***                and then print the report).                                                                                                                                                                                                            
***                                                                                                                                                                                                                                                       
* SET COLO TO BG+/B,W+/N                                                                                                                                                                                                                                  
* set proc to sospro                                                                                                                                                                                                                                      
* set proc to addrpro1                                                                                                                                                                                                                                    
* do start                                                                                                                                                                                                                                                
                                                                                                                                                                                                                                                          
*-------                                                                                                                                                                                                                                                  
TEMP=SAVESCREEN(0,0,24,79)                                                                                                                                                                                                                                
*CLEA                                                                                                                                                                                                                                                     
set excl off                                                                                                                                                                                                                                              
baris=0                                                                                                                                                                                                                                                   
page=1                                                                                                                                                                                                                                                    
code=space(5)                                                                                                                                                                                                                                             
dr1='N:'                                                                                                                                                                                                                                                  
dr2='Q:'                                                                                                                                                                                                                                                  
f1='DRUGLEE'                                                                                                                                                                                                                                              
f2='ACT_PHAX'                                                                                                                                                                                                                                             
f3='DRUGS'                                                                                                                                                                                                                                                
set date brit                                                                                                                                                                                                                                             
WFRM=ctod('  /  /    ')                                                                                                                                                                                                                                   
WTOM=ctod('  /  /    ')                                                                                                                                                                                                                                   
WX=5                                                                                                                                                                                                                                                      
SELE 3                                                                                                                                                                                                                                                    
USE &DR1&F3 INDE &DR1&F3                                                                                                                                                                                                                                  
SELE 2                                                                                                                                                                                                                                                    
USE &DR2&F2 INDE &DR2&F2                                                                                                                                                                                                                                  
GO BOTT                                                                                                                                                                                                                                                   
*WTOM=DATE_VISIT                                                                                                                                                                                                                                          
                                                                                                                                                                                                                                                          
@ 11,45 SAY 'From Date : dd/mm/yy to dd/mm/yy'                                                                                                                                                                                                            
@ 12,45 say '              (max. 5 months)'                                                                                                                                                                                                               
          * 2         3         4         5                                                                                                                                                                                                               
          *  123456789 123456789 123456789 123456789                                                                                                                                                                                                      
DO WHIL .T.                                                                                                                                                                                                                                               
   @ 11,57 get wfrm                                                                                                                                                                                                                                       
   read                                                                                                                                                                                                                                                   
   @ 23,01 say spac(50)                                                                                                                                                                                                                                   
   wwm=month(wfrm)+5                                                                                                                                                                                                                                      
   wwy=year(wfrm)                                                                                                                                                                                                                                         
   if wwm>12                                                                                                                                                                                                                                              
      wwm=wwm-12                                                                                                                                                                                                                                          
      wwy=wwy+1                                                                                                                                                                                                                                           
   endi                                                                                                                                                                                                                                                   
   wtom=(CTOD('01/'+strzero(wwm,2)+'/'+subs(str(wwy,4),3,2)))-1                                                                                                                                                                                           
   @ 11,69 get wtom                                                                                                                                                                                                                                       
   read                                                                                                                                                                                                                                                   
   if wfrm>wtom                                                                                                                                                                                                                                           
      @ 23,01 say 'From Date should be <= To Date'                                                                                                                                                                                                        
      loop                                                                                                                                                                                                                                                
   endi                                                                                                                                                                                                                                                   
*   wx=(month(wtom)-month(wfrm))+1                                                                                                                                                                                                                        
*   if month(wtom)<month(wfrm)                                                                                                                                                                                                                            
      wx=(((year(wtom)-year(wfrm))*12+month(wtom))-month(wfrm))+1                                                                                                                                                                                         
*   endi                                                                                                                                                                                                                                                  
   if wx>5                                                                                                                                                                                                                                                
      @ 23,01 say 'Max. 5 months'                                                                                                                                                                                                                         
      loop                                                                                                                                                                                                                                                
   endi                                                                                                                                                                                                                                                   
   pil=0                                                                                                                                                                                                                                                  
   @ 13,45 say 'Data OK ? : Y / N / C'                                                                                                                                                                                                                    
   @ 13,57 prompt 'Y'                                                                                                                                                                                                                                     
   @ 13,61 prompt 'N'                                                                                                                                                                                                                                     
   @ 13,65 prompt 'C'                                                                                                                                                                                                                                     
   menu to pil                                                                                                                                                                                                                                            
   do case                                                                                                                                                                                                                                                
      case pil=1                                                                                                                                                                                                                                          
           exit                                                                                                                                                                                                                                           
      case pil=2                                                                                                                                                                                                                                          
           loop                                                                                                                                                                                                                                           
      case pil=3                                                                                                                                                                                                                                          
           clos data                                                                                                                                                                                                                                      
           restscreen(0,0,24,79,temp)                                                                                                                                                                                                                     
           retu                                                                                                                                                                                                                                           
   endc                                                                                                                                                                                                                                                   
ENDD                                                                                                                                                                                                                                                      
stor 0 to pl1,pl2                                                                                                                                                                                                                                         
do while pl1=0                                                                                                                                                                                                                                            
   @ 13,45 say spac(25)                                                                                                                                                                                                                                   
   @ 13,51 say '/'                                                                                                                                                                                                                                        
   @ 13,45 prompt 'Print'                                                                                                                                                                                                                                 
   @ 13,53 prompt 'Quit'                                                                                                                                                                                                                                  
   menu to pl1                                                                                                                                                                                                                                            
   if pl1=2                                                                                                                                                                                                                                               
      CLOS DATA                                                                                                                                                                                                                                           
      restscreen(0,0,24,79,temp)                                                                                                                                                                                                                          
      RETURN                                                                                                                                                                                                                                              
   else                                                                                                                                                                                                                                                   
      @ 14,59 say '/'                                                                                                                                                                                                                                     
      @ 14,45 prompt 'Printer Ready'                                                                                                                                                                                                                      
      @ 14,61 prompt 'Not Yet Ready'                                                                                                                                                                                                                      
      menu to pl2                                                                                                                                                                                                                                         
      if pl2=2                                                                                                                                                                                                                                            
         @ 14,45 clea to 14,78                                                                                                                                                                                                                            
         pl1=0                                                                                                                                                                                                                                            
      endif                                                                                                                                                                                                                                               
   endif                                                                                                                                                                                                                                                  
enddo                                                                                                                                                                                                                                                     
*@  6,25  SAY 'From '+cmonth(WFRM)+' '+subs(dtoc(WFRM),7,4)+' to '+cmonth(WTOM)+' '+subs(dtoc(WTOM),7,2)                                                                                                                                                  
SELE 1                                                                                                                                                                                                                                                    
USE &DR2&F1 INDE &DR2&F1 EXCL                                                                                                                                                                                                                             
repl all qty1 with 0, amt1 with 0, qty2 with 0, amt2 with 0,qty3 with 0, amt3 with 0, qty4 with 0, amt4 with 0,qty5 with 0, amt5 with 0                                                                                                                   
GO TOP                                                                                                                                                                                                                                                    
XX=1                                                                                                                                                                                                                                                      
STOR CTOD('  /  /    ') TO WDATE,WMM,WYY                                                                                                                                                                                                                  
SELE 2                                                                                                                                                                                                                                                    
go top                                                                                                                                                                                                                                                    
@ 13,45 clea to 14,78                                                                                                                                                                                                                                     
DO WHIL XX<=WX                                                                                                                                                                                                                                            
   WDATE=WFRM+(XX-1)*31                                                                                                                                                                                                                                   
   WMM=SUBS(DTOC(WDATE),4,2)                                                                                                                                                                                                                              
   WYY=SUBS(DTOC(WDATE),7,4)                                                                                                                                                                                                                              
   WDATE=CTOD('01/'+WMM+'/'+WYY)                                                                                                                                                                                                                          
   @ 14,58 SAY SPAC(12)                                                                                                                                                                                                                                   
   @ 14,45 SAY 'PROCESSING : '+CMONTH(WDATE)+' '+WYY                                                                                                                                                                                                      
   STOR 0 TO WCOUNT,WDISP                                                                                                                                                                                                                                 
   SEEK DTOS(WDATE)                                                                                                                                                                                                                                       
   DO WHIL .NOT. EOF() .AND. ALLTRIM(CMONTH(WDATE))=ALLTRIM(CMONTH(DATE_VISIT))                                                                                                                                                                           
      @ 15,58 SAY SPAC(12)                                                                                                                                                                                                                                
      @ 15,45 SAY 'DATE VISIT : '+DTOC(DATE_VISIT)                                                                                                                                                                                                        
      sele 1                                                                                                                                                                                                                                              
      seek B->PHAR_CODE                                                                                                                                                                                                                                   
      wflag=.t.                                                                                                                                                                                                                                           
      if eof()                                                                                                                                                                                                                                            
         sele 3                                                                                                                                                                                                                                           
         seek B->PHAR_CODE                                                                                                                                                                                                                                
         if .not. eof()                                                                                                                                                                                                                                   
            sele 1                                                                                                                                                                                                                                        
            appe blank                                                                                                                                                                                                                                    
            repl drug_code with C->drug_code, drug_name with C->drug_name                                                                                                                                                                                 
            repl drug_unit with C->drug_unit, drug_qant with C->drug_qant                                                                                                                                                                                 
            repl sell_unit with C->sell_unit, drug_type with C->drug_type                                                                                                                                                                                 
            repl for_sale  with C->for_sale                                                                                                                                                                                                               
            commit                                                                                                                                                                                                                                        
         else                                                                                                                                                                                                                                             
            sele 1                                                                                                                                                                                                                                        
            wflag=.f.                                                                                                                                                                                                                                     
         endi                                                                                                                                                                                                                                             
      endi                                                                                                                                                                                                                                                
      if wflag                                                                                                                                                                                                                                            
         wxx=str(xx,1)                                                                                                                                                                                                                                    
         wqty='qty'+str(xx,1)                                                                                                                                                                                                                             
         wamt='amt'+str(xx,1)                                                                                                                                                                                                                             
         repl qty&wxx with &wqty+1, amt&wxx with &wamt+B->PHAR_X                                                                                                                                                                                          
         commit                                                                                                                                                                                                                                           
      endi                                                                                                                                                                                                                                                
      sele 2                                                                                                                                                                                                                                              
      SKIP                                                                                                                                                                                                                                                
   ENDD                                                                                                                                                                                                                                                   
   XX=XX+1                                                                                                                                                                                                                                                
ENDD                                                                                                                                                                                                                                                      
sele 1                                                                                                                                                                                                                                                    
go top                                                                                                                                                                                                                                                    
wfl=0                                                                                                                                                                                                                                                     
DO WHIL .NOT. EOF()                                                                                                                                                                                                                                       
   if wfl=0                                                                                                                                                                                                                                               
      wfl=1                                                                                                                                                                                                                                               
      @ 17,45 say '     Printing...    '                                                                                                                                                                                                                  
      set devi to prin                                                                                                                                                                                                                                    
*       set prin to repdrug                                                                                                                                                                                                                               
   endi                                                                                                                                                                                                                                                   
   IF BARIS=0                                                                                                                                                                                                                                             
      @  2, 1  SAY 'S.O.S. MEDIKA'                                                                                                                                                                                                                        
      @  2,118 SAY DTOC(DATE())                                                                                                                                                                                                                           
      @  4,36  SAY 'QUANTITATIVE ANALYSIS OF S.O.S. MEDIKA SALES OF MEDICATIONS'                                                                                                                                                                          
      @  6,48  SAY 'From '+cmonth(WFRM)+' '+subs(dtoc(WFRM),7,4)+' to '+cmonth(WTOM)+' '+subs(dtoc(WTOM),7,2)                                                                                                                                             
      @  6,118 SAY 'Page : '+STR(PAGE,2,0)                                                                                                                                                                                                                
      @  8,01  SAY 'CODE'                                                                                                                                                                                                                                 
      @  8,08  SAY 'DESCRIPTION OF MEDICATION'                                                                                                                                                                                                            
*         1         2         3         4         5         6         7         8         9        10        11        12        13        14        15        16                                                                                         
*123456789 123456789 123456789 123456789 123456789 123456789 123456789 123456789 123456789 123456789 123456789 123456789 123456789 123456789 123456789 123456789                                                                                          
*S.O.S. MEDIKA                                                                                                             99/99/9999                                                                                                                     
*                                                                                                                                                                                                                                                         
*                                   QUANTITATIVE ANALYSIS OF S.O.S. MEDIKA SALES OF MEDICATIONS                                                                                                                                                           
*                                                                                                                                                                                                                                                         
*                                               From October 1992 to September 1993                                       Page : 99                                                                                                                       
*                                                                                                                                                                                                                                                         
*CODE   DESCRIPTION OF MEDICATION          X-----------X  X-----------X  X-----------X  X-----------X  X-----------X   VOLUME SOLD                                                                                                                        
*9999   X------------------------------X   9,999 999,999  9,999 999,999  9,999 999,999  9,999 999,999  9,999 999,999   X----------X                                                                                                                       
*         1         2         3         4         5         6         7         8         9        10        11        12        13        14        15        16                                                                                         
*123456789 123456789 123456789 123456789 123456789 123456789 123456789 123456789 123456789 123456789 123456789 123456789 123456789 123456789 123456789 123456789                                                                                          
      XX=1                                                                                                                                                                                                                                                
      DO WHIL XX<=WX                                                                                                                                                                                                                                      
         @ 8,(XX-1)*15+43 SAY CMONTH(WFRM+(XX-1)*31) PICT '@!'                                                                                                                                                                                            
         @ 8,(XX-1)*15+43+LEN(ALLTRIM(CMONTH(WFRM+(XX-1)*31))) SAY REPL('-',13-LEN(ALLTRIM(CMONTH(WFRM+(XX-1)*31))))                                                                                                                                      
         XX=XX+1                                                                                                                                                                                                                                          
      ENDD                                                                                                                                                                                                                                                
      @  8,119 SAY 'VOL.SOLD'                                                                                                                                                                                                                             
      BARIS=10                                                                                                                                                                                                                                            
   ENDIF                                                                                                                                                                                                                                                  
   SELE 1                                                                                                                                                                                                                                                 
*SET DEVI TO SCRE                                                                                                                                                                                                                                         
*   @ 08,25 SAY 'PROCESSING DRUG CODE : '+DRUG_CODE                                                                                                                                                                                                       
*SET DEVI TO PRIN                                                                                                                                                                                                                                         
   IF FOR_SALE .AND. SUBSTR(DRUG_CODE,2,1)$'012'                                                                                                                                                                                                          
      xx=1                                                                                                                                                                                                                                                
      CODE=DRUG_CODE                                                                                                                                                                                                                                      
      SELL=SELL_UNIT                                                                                                                                                                                                                                      
      @ baris, 1 say code                                                                                                                                                                                                                                 
      @ baris, 8 say SUBS((ALLTRIM(DRUG_NAME)+' '+ALLTRIM(DRUG_TYPE)+'  '+ALLTRIM(DRUG_UNIT)+' '+ALLTRIM(DRUG_QANT)),1,32)                                                                                                                                
      do whil xx<=wx                                                                                                                                                                                                                                      
         wxx=str(xx,1)                                                                                                                                                                                                                                    
         wqty='qty'+str(xx,1)                                                                                                                                                                                                                             
         wamt='amt'+str(xx,1)                                                                                                                                                                                                                             
         IF &wqty#0 .OR. &wamt#0                                                                                                                                                                                                                          
            @ BARIS,(XX-1)*15+43 SAY qty&wxx  PICT '9,999'                                                                                                                                                                                                
            DO SAYG WITH BARIS,(XX-1)*15+49,AMT&WXX,'9,999.99','999,999'                                                                                                                                                                                  
*            @ BARIS,(XX-1)*15+49 SAY amt&wxx  PICT '999,999'                                                                                                                                                                                             
         ENDI                                                                                                                                                                                                                                             
         xx=xx+1                                                                                                                                                                                                                                          
      endd                                                                                                                                                                                                                                                
      @ BARIS,119 SAY SUBS(SELL,1,9)  PICT '@!'                                                                                                                                                                                                           
      baris=baris+1                                                                                                                                                                                                                                       
      IF BARIS>=55                                                                                                                                                                                                                                        
         page=page+1                                                                                                                                                                                                                                      
         @ 62,3 SAY 'Continued Page '+str(page,2,0)                                                                                                                                                                                                       
         eject                                                                                                                                                                                                                                            
         baris=0                                                                                                                                                                                                                                          
      endif                                                                                                                                                                                                                                               
   ENDIF                                                                                                                                                                                                                                                  
   SELE 1                                                                                                                                                                                                                                                 
   SKIP                                                                                                                                                                                                                                                   
ENDDO                                                                                                                                                                                                                                                     
if wfl=1                                                                                                                                                                                                                                                  
   eject                                                                                                                                                                                                                                                  
endi                                                                                                                                                                                                                                                      
CLOS DATA                                                                                                                                                                                                                                                 
set devi to screen                                                                                                                                                                                                                                        
restscreen(0,0,24,79,temp)                                                                                                                                                                                                                                
RETURN                                                                                                                                                                                                                                                    
                                                                                                                                                                                                                                                          
